home *** CD-ROM | disk | FTP | other *** search
/ ftp.mactech.com 2010 / ftp.mactech.com.tar / ftp.mactech.com / util / Mac F2C 1.3.sit / Mac F2C 1.3 / Test Project ƒ / test.f < prev    next >
Text File  |  1995-11-03  |  6KB  |  221 lines
  1.     Program test_f2c
  2.     
  3. c    This is a FORTRAN program to test Mac F2C v1.1
  4.  
  5.     character    junk*2
  6.  
  7.     write( 6, * ) '*****   Input/Output Test   *****'
  8.     call i_o_test
  9.     write(6,*) '\n*****   End of I/O test, hit return to continue...'
  10.     read(5,99) junk
  11. 99    format( a1 )
  12.  
  13.     write( 6, *) '\n*****   Integer Math Test   *****'    
  14.     call int_test( 10 )
  15.     write(6,*) '\n*****   End of integer math test, hit return to continue...'
  16.     read(5,99) junk
  17.  
  18.     write( 6, * ) '\n*****   Floating Point Math Test   *****'
  19.     call flt_test( 10 )
  20.     write(6,*) '\n*****   End of floating point math test, hit return to continue...'
  21.     read(5,99) junk
  22.  
  23.     write( 6, * ) '\n*****   Algebraic Function Test   *****'
  24.     call alg_test( 10 )
  25.     write(6,*) '\n*****   End of algebraic function test, hit return to continue...'
  26.     read(5,99) junk
  27.  
  28.     write( 6, * ) '\n*****   Transcendental Function Test   *****'
  29.     call trn_test
  30.     write(6,*) '\n*****   End of transcendental function test, hit return to continue...'
  31.     read(5,99) junk
  32.     
  33.     write(6,*) '##########################################################################'
  34.     write(6,*) ' If you noticed that floating point values did not round correctly when'
  35.     write(6,*) ' displayed, please read the enclosed file "If Floats Don\'t Display Right"'
  36.     write(6,*) '##########################################################################'
  37.     write( 6, * ) '\n*****   This completes all of the tests   *****'
  38.     
  39.     stop
  40.     end
  41.     
  42.     
  43.  
  44. c************************************************************************
  45. c
  46. c    Subroutine to do the I/O tests
  47. c
  48. c************************************************************************
  49.     
  50.     subroutine  i_o_test
  51.     dimension a(5), j(5)
  52.     double precision  dx
  53.     character text*40
  54.     
  55. c     Screen I/O tests
  56.  
  57.     write(6,*) '\nPart 1:  Screen I/O tests.\n\nEnter an integer value.'
  58.     read(5,*) i
  59.     write(6,*) 'The number you entered was:', i
  60.  
  61.     write(6,*) '\nEnter a single precision floating point value...'
  62.     read(5,*) x
  63.     write(6,*) 'The number you entered was: ', x
  64.  
  65.     write(6,*) '\nEnter a double precision floating point value...'
  66.     read(5,*) dx
  67.     write(6,*) 'The number you entered was: ', dx
  68.  
  69.     write(6,*) '\nEnter some text (40 char max)...'
  70.     read(5,*) text
  71.     write(6,*) 'The text you entered was: ', text
  72.     
  73.     write(6,*) '\nPart 2:  file I/O tests.  Hit return to continue...'
  74.     read(5,399) text
  75. 399    format( a1 )
  76.     
  77. c     File I/O tests:  Store some values and write them to file
  78.  
  79.     do i = 1,5
  80.       j(i) = i
  81.       a(i) = dble(i)
  82.     enddo
  83.     text = 'A test message.'
  84.     open(60,file='test.dat',form='unformatted')
  85.     write(60) text, j, a
  86.     close(60)
  87.     
  88.     write(6,*) 'Wrote the following data to file test.dat:\n'
  89.     write(6, 304) text, (j(i), i =1,5), (a(i), i = 1,5)
  90. 304    format( 5x, a20, 5(i1, 2x), 5x, 5(f4.2, 2x) )
  91.  
  92. c Reset the variables and read them back
  93.  
  94.     do i = 1,5
  95.       j(i) = 99
  96.       a(i) = 99
  97.     enddo
  98.     text = 'reset'
  99.     open(50,file='test.dat',form='unformatted')
  100.     read(50) text, j, a
  101.     close(50)
  102.     
  103.     write(6, *) '\nRead the following data from file test.dat:\n' 
  104.     write(6, 304) text, (j(i), i =1,5), (a(i), i = 1,5)
  105.  
  106.     return
  107.     end
  108.     
  109.     
  110.     
  111.     
  112. c************************************************************************
  113. c
  114. c    Subroutine to do the integer math tests
  115. c
  116. c************************************************************************
  117.  
  118.     subroutine  int_test( m )
  119.     write( 6, *) '\nGenerate a table of integers, squares, cubes, and their halves.\n'
  120.     write(6, 203)
  121. 203    format( 10x, 'n', 5x, 'n^2', 5x, 'n^3', 5x, 'n/2', 3x, 'n^2/2', 3x, 'n^3/2' )
  122.     do i = 1, m
  123.         j = i**2
  124.         k = i**3
  125.         write( 6, 202 )  i, j, k, i/2, j/2, k/2
  126. 202        format( 5x, 6( i6, 2x ) )
  127.     end do
  128.     return
  129.     end
  130.  
  131.  
  132.  
  133. c************************************************************************
  134. c
  135. c    Subroutine to do the floating point math tests
  136. c
  137. c************************************************************************
  138.  
  139.     subroutine  flt_test( m )
  140.     write( 6, * ) '\nGenerate a table of floats, their squares, cubes, and their halves.\n'
  141.     write(6, 205)
  142. 205    format( 12x, 'x', 6x, 'x^2', 6x, 'x^3', 6x, 'x/2', 4x, 'x^2/2', 4x, 'x^3/2' )
  143.     do i = 1, m
  144.         x1 = i*1.0
  145.         x2 = x1**2
  146.         x3 = x1**3
  147.         write( 6, 201 )  x1, x2, x3, x1/2, x2/2, x3/2
  148. 201        format( 5x, 6( f8.2, 1x ) )
  149.     end do
  150.     return
  151.     end
  152.  
  153.  
  154.  
  155.  
  156. c************************************************************************
  157. c
  158. c    Subroutine to do the algebraic function tests
  159. c
  160. c************************************************************************
  161.  
  162.     subroutine  alg_test( m )
  163.     write( 6, * ) '\nGenerate a table of floats, square & cube roots, and their squares & cubes.\n'
  164.     write(6, 305)
  165. 305    format( 10x, 'x', 7x, 'SQRT(x)', 4x, 'CURT(x)', 3x, 'SQRT(x)^2', 2x, 'CURT(x)^3' )
  166.     do i = 1, m
  167.         x1 = i*1.0
  168.         x2 = sqrt(x1)
  169.         x3 = x1**(1.0/3.0)
  170.         write( 6, 301 )  x1, x2, x3, x2**2, x3**3
  171. 301        format( 5x, 6( f9.6, 2x ) )
  172.     end do
  173.     return
  174.     end
  175.  
  176.  
  177.  
  178.  
  179. c************************************************************************
  180. c
  181. c    Subroutine to do the transcendental function tests
  182. c
  183. c************************************************************************
  184.  
  185.     subroutine  trn_test
  186.     double precision  pi, x, s, c, s2, c2
  187.     character junk*2
  188.     
  189.     pi = 3.141592653589793
  190.     write( 6, * ) '\nPart 1: Trig Functions'
  191.     write( 6, *) '\nGenerate a table of x, sin(x), cos(x) and the sum of their squares.\n'
  192.     write(6, 207)
  193. 207    format( 9x, 'x', 9x, 'sin(x)', 8x, 'cos(x)', 4x, 'sin(x)^2 + cos(x)^2' )
  194.     do i = 0, 12
  195.         x = i * pi / 6.0
  196.         s = dsin( x )
  197.         c = dcos( x )
  198.         s2 = s**2
  199.         c2 = c**2
  200.         write( 6, 200) i, s, c, s2 + c2
  201. 200        format( 5x, i2,'*pi/6' 3x, f11.8, 3x, f11.8, 3x, f15.10 )
  202.     end do
  203.  
  204.     write(6,*) '\nPart 2:  Exponential functions; hit return to continue...'
  205.     read(5,299) junk
  206. 299    format( a1 )
  207.  
  208.     write(6,*) 'Generate a table of x, log(x), and exp(log(x))\n'
  209.     write(6, 208)
  210. 208    format( 11x, 'x', 16x, 'log(x)', 9x, 'exp(log(x))' )
  211.     do i = 1, 10
  212.         x = dble(i)
  213.         s = dlog(x)
  214.         c = dexp(s)
  215.         write(6, 201) x, s, c
  216. 201        format( 5x, f13.10, 5x, f13.10, 5x, f13.10 )
  217.     end do
  218.     
  219.     return
  220.     end
  221.